home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DOS.SWG / 0013_DOS ICA Put-Get Routine.pas < prev    next >
Pascal/Delphi Source File  |  1993-07-16  |  3KB  |  127 lines
  1. ===========================================================================
  2.  BBS: Canada Remote Systems
  3. Date: 06-30-93 (07:05)             Number: 28694
  4. From: ROB GREEN                    Refer#: NONE
  5.   To: RAND NOWELL                   Recvd: NO  
  6. Subj: CODE FOR PROGRAM               Conf: (1221) F-PASCAL
  7. ---------------------------------------------------------------------------
  8.  > Another way would be to, upon program startup, is create an
  9.  > enviornment var refering to your program. Say the program is
  10.  > RR.EXE, create a var as Set RR = INSTALLED!  then when you
  11.  > shell, search the enviornment for RR, if it equals INSTALLED!
  12.  > then present message, if the RR var not exists, then load the
  13.  > program.  Of course when the program quits you want to seet RR =
  14.  >    (nothing).....
  15.  
  16. Heres the way i do it...
  17.  
  18. unit AmLoaded;
  19.  
  20. interface
  21.  
  22. type
  23.    ICAType   = record
  24.        Stext : string[13];
  25.        chksum: integer;
  26.    end;
  27.  
  28. var
  29.   ica : icaType absolute $0000:$04f0;
  30.  
  31. Procedure PutICA(sText:string);
  32.  
  33. procedure GetIca(var stext:string);
  34.  
  35. function  IcaSame(Stext:string):boolean;
  36.  
  37.  
  38. implementation
  39.  
  40. Procedure PutICA(sText:string);
  41. var
  42.    j:byte;
  43. Begin
  44.    fillchar(ica.stext,sizeof(ica.stext),0);
  45.    ica.stext:=copy(stext,1,13);
  46.    ica.stext[0]:=#13;
  47.    Ica.ChkSum:=0;
  48.    for j:=0 to 13 do
  49.       Ica.ChkSum:=Ica.ChkSum+ord(ica.stext[j]);
  50. End;
  51.  
  52.  
  53. Procedure GetIca(var stext:string);
  54. Begin
  55.    stext:=ica.stext;
  56. End;
  57.  
  58. function  IcaSame:boolean;
  59. var
  60.    j:byte;
  61.    k,m:integer;
  62. begin
  63.    k:=0;
  64.    m:=0;
  65.    for j:=0 to 13 do
  66.    Begin
  67.       k:=k+ord(ica.stext[j]);
  68.       m:=m+ord(stext[j]);
  69.    end;
  70.    if k=m then
  71.    Begin
  72.       if ica.chksum=m then
  73.          IcaSame:=true
  74.       else
  75.          IcaSame:=False;
  76.    end
  77.    else
  78.       icasame:=false;
  79. end;
  80.  
  81. end.
  82. -----------------------
  83. Test program:
  84.  
  85. uses AmLoaded;
  86. Begin
  87.    PutIca('ATEST');
  88.    Writeln('ATEST, should come back as same');
  89.    {Check to see if we can read it back without changing anything}
  90.    If IcaSame('ATEST') then
  91.       writeln('Same')
  92.    else
  93.       writeln('Not Same');
  94.    PutICA('Another Test');
  95.    Writeln('Another Test, should come back as not same');
  96.    {Change the lower case 'h' into an uppercase 'H'}
  97.    Ica.Stext[5]:='H';
  98.    If IcaSame('Another Test') then
  99.       writeln('Same')
  100.    else
  101.       writeln('Not same');
  102.    PutIca('hello world');
  103.    writeln('Hello world, should come back as not same');
  104.    {Change the chksum}
  105.    ica.chksum:=111;
  106.    If IcaSame('hello world'); then
  107.       writeln('Same')
  108.    else
  109.       writeln('Not same');
  110. End.
  111. -------------------------------------------
  112.  
  113. Before doing EXEC do this:
  114. PutICA('Program name');  {up to 13 chars}
  115. EXEC(getenv('COMSPEC'),'Whatever');
  116. PutIca('            ');  {Or null}
  117.  
  118. Then when starting your program do this:
  119. If ICASame('Program name') then
  120.    writeln('Can''t load Program name on top of itself');
  121.  
  122.  
  123. Rob
  124.  
  125. --- FMail 0.94
  126.  * Origin: The Rush Room - We OWN Orlando - (407) 678 & 0749 (1:363/166)
  127.